C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C ----------------------------------------------------------------------
C
C       A N B L K   -   Global data constants for ISTAN
C
 
        BLOCK DATA ANBLK
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Option Settings
        COMMON /OPTSC/ INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,
     +                 MTREQG,TIEG,ITRUNG
 
        INTEGER INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,MTREQG,
     +          ITRUNG
        LOGICAL TIEG
 
        SAVE /OPTSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
 
C **********************************************************************
C *                                                                    *
C *     HOST-SENSITIVE VALUES:                                         *
C *     ----------------------                                         *
C *     The following values are for i/o unit numbers, used in non     *
C *     TIE-conforming programs.  They should be set to something      *
C *     appropriate for the host system.                               *
C *         INHSTG  -  History file input unit                         *
C *         ITHSTG  -  History file output unit                        *
C *         INTRAG  -  Trace information input unit (standard input)   *
C *         ITTRAG  -  Trace information output unit (standard o/p)    *
C *         ITLSTG  -  Listing output unit (standard output)           *
C *                                                                    *
C **********************************************************************
 
C Option defaults
        DATA ASSRTG,HISTG,TIEG,TRACEG/4*.FALSE./
C Instrumented program I/O units
        DATA INHSTG,ITHSTG,INTRAG,ITTRAG,ITLSTG,ITRUNG,VNAMEG/
     +          8  ,   8  ,   5  ,   6  ,   6  ,  -1  ,'ZZ4QX'/
C Instrumented program: TRACE circular buffer size
        DATA MCIRCG/100/
C Instrumented program: Maximum number of TRACE requests
        DATA MTREQG/25/
 
        END
C ----------------------------------------------------------------------
C
C       A S S R T S   -   Process and output an assertion statement
C
 
        SUBROUTINE ASSRTS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Character variables and arrays, except for dictionaries & VNAMEG
        INTEGER MAXCMG
        PARAMETER(MAXCMG=30)
        COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
 
        CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
        CHARACTER*6 NAMEG
        CHARACTER*72 ICOMG(MAXCMG)
 
        SAVE /CHARC/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/ANVNAM/VNAMEG
        CHARACTER*5 VNAMEG
        SAVE/ANVNAM/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        INTEGER JCOL,ICOL,L
        CHARACTER*5 ASSNUM
        CHARACTER*72 CMTEXT
 
*$AS$ (ASSRTG)
*$AS$ (NSTMG.GT.0)
*$AS$ (ISTMG(1).EQ.'*')
        NMASRG=NMASRG+1
C Output first annotated listing line
        WRITE(ASSNUM,9000) NMASRG
        CALL WRITOK(TCMMNT,'*$AN$'//ASSNUM//'A')
        DO 50 L=1,MIN(72,NSTMG)
            CMTEXT(L:L)=ISTMG(L)
  50    CONTINUE
        CALL WRITOK(TCMMNT,CMTEXT(:MIN(72,NSTMG)))
C Output additional annotated listing lines, if required
        IF (NSTMG.GT.72) THEN
            DO 200 ICOL=73,NSTMG,71
                JCOL=MIN(ICOL+70,NSTMG)
                DO 100 L=ICOL,JCOL
 100                CMTEXT(L-ICOL+1:L-ICOL+1)=ISTMG(L)
                CALL WRITOK(TCMMNT,'*'//CMTEXT(:JCOL-ICOL+1))
 200        CONTINUE
        END IF
*$as$ (NBUFFG.EQ.0)
        NBUFFG=0
        CALL SENDCH('      CALL M'//VNAMEG//'(')
        CALL SENDAS
        CALL SENDCH(','//ASSNUM//')')
        CALL SEND
 
9000    FORMAT(SS,I5)
        END
C ----------------------------------------------------------------------
C
C       B A D A S   -   Current assertion statement bad.
C                       Ignore as assertion and output with comments.
C
 
        SUBROUTINE BADAS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Character variables and arrays, except for dictionaries & VNAMEG
        INTEGER MAXCMG
        PARAMETER(MAXCMG=30)
        COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
 
        CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
        CHARACTER*6 NAMEG
        CHARACTER*72 ICOMG(MAXCMG)
 
        SAVE /CHARC/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  KEYWORD ID VARIABLES
      COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
     *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
     *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
     *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
     *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
     *         KDOG,        KELSEG,      KELSFG,      KENDFG,
     *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
     *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
     *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
     *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
     *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
     *         KREADG,      KREALG,      KRETNG,      KRFUNG,
     *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
     *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
     *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
     *         LLINEG,      LSTMTG
 
        INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
     +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
     +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
     +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
     +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
     +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
     +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
     +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
        INTEGER KUFUNG,KSUBRG
 
        SAVE /KEYSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        INTEGER NSTML,MSTML,L
        CHARACTER*71 CMTEXT
 
        NSTML=1
*$AS$ (NSTMG.GT.0 .AND. ASSRTG)
C Locate next assertion card end
  100   NSTML=NSTML+71
        CALL COUNTS(LCMNTG)
        MSTML=NSTML-70
        DO 200 L=MSTML,NSTML
 200        CMTEXT(L-MSTML+1:L-MSTML+1)=ISTMG(L)
        CALL WRITOK(TCMMNT,'C'//CMTEXT)
C Are there more assertion cards?
        IF (NSTML.LT.NSTMG) GOTO 100
        NSTMG=0
 
        END
C ----------------------------------------------------------------------
C
C       B A L C C S   -   Find the end of a character constant field.
C                         return the column of the last character if
C                         found, or the starting column if not found.
C
 
        SUBROUTINE BALCCS(ICOLA,JCOLA)
        INTEGER ICOLA,JCOLA
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Character variables and arrays, except for dictionaries & VNAMEG
        INTEGER MAXCMG
        PARAMETER(MAXCMG=30)
        COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
 
        CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
        CHARACTER*6 NAMEG
        CHARACTER*72 ICOMG(MAXCMG)
 
        SAVE /CHARC/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
 
        INTEGER ICOL,L
 
C Start search in column after first quote
        ICOL=ICOLA+1
        IF (NSTMG.GE.ICOL) THEN
  100       DO 200 L=ICOL,NSTMG
C Check for two consecutive quotes
                IF (ISTMG(L).EQ.'''') THEN
                    IF (ISTMG(L+1).NE.'''' .OR. L+1.GT.NSTMG) THEN
C End of field found
                        JCOLA=L
                        RETURN
                    ELSE
C Skip over two consecutive quotes
                        ICOL=L+2
                        GOTO 100
                    END IF
                END IF
  200       CONTINUE
        END IF
C End of field never located
        JCOLA = ICOLA
 
        END
C ----------------------------------------------------------------------
C
C       B A L P R S   -   Balance parentheses. Return column of end of
C                         field if found, or a zero if not balanced.
C                         [This works on assertion statements only].
C
 
        SUBROUTINE BALPRS(ICOLA,JCOLA)
        INTEGER ICOLA,JCOLA
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Character variables and arrays, except for dictionaries & VNAMEG
        INTEGER MAXCMG
        PARAMETER(MAXCMG=30)
        COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
 
        CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
        CHARACTER*6 NAMEG
        CHARACTER*72 ICOMG(MAXCMG)
 
        SAVE /CHARC/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
 
        INTEGER ICOL,IBAL,L,NEWL
 
        IBAL=-1
        JCOLA=0
        ICOL=ICOLA
        IF (NSTMG.GE.ICOL) THEN
  100       DO 200 L=ICOL,NSTMG
C Is this the start of the field?
                IF (IBAL.LT.0 .AND. ISTMG(L).EQ.'(') THEN
                    IBAL=1
C Is this the start of a subfield?
                ELSE IF (ISTMG(L).EQ.'(') THEN
                    IBAL=IBAL+1
C Is this the end of a field?
                ELSE IF (ISTMG(L).EQ.')') THEN
                    IBAL=IBAL-1
C Is this the start of a character constant field?
                ELSE IF (ISTMG(L).EQ.'''') THEN
C Find the end of the character constant field.
                    CALL BALCCS(L,NEWL)
                    IF (NEWL.EQ.L) THEN
C No end to character constant found
                        RETURN
                    ELSE
C End to character constant found
                        ICOL=NEWL+1
                        GOTO 100
                    END IF
                END IF
C Do the parentheses balance?
                IF (IBAL.EQ.0) THEN
                    JCOLA=L
                    RETURN
                END IF
  200       CONTINUE
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       B A L P R T   -   Balance parentheses (token version).
C                         Return token of closing parenthesis if found,
C                         or zero if unbalanced.
C
 
        SUBROUTINE BALPRT(ITOKA,JTOKA)
        INTEGER ITOKA,JTOKA
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
 
        INTEGER IBAL,ITOK,L
 
        IBAL=-1
        JTOKA=0
        ITOK=ITOKA
        IF (NTOKSS.GE.ITOK) THEN
            DO 100 L=ITOK,NTOKSS
                IF (TOKTYP(L).EQ.TLPARN) THEN
                    IF (IBAL.LT.0) IBAL=0
                    IBAL=IBAL+1
                ELSE IF (TOKTYP(L).EQ.TRPARN) THEN
                    IBAL=IBAL-1
                END IF
                IF (IBAL.EQ.0) THEN
                    JTOKA=L
                    RETURN
                END IF
 100        CONTINUE
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       S E N D A S   -   Send assertion to intermediate file, with
C                         blanks suppressed (except in char constants).
C
 
        SUBROUTINE SENDAS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Character variables and arrays, except for dictionaries & VNAMEG
        INTEGER MAXCMG
        PARAMETER(MAXCMG=30)
        COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
 
        CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
        CHARACTER*6 NAMEG
        CHARACTER*72 ICOMG(MAXCMG)
 
        SAVE /CHARC/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
 
        INTEGER I
        LOGICAL CCONST
 
        CCONST=.FALSE.
        DO 100 I=2,NSTMG
            IF (ISTMG(I).EQ.'''') CCONST=.NOT.CCONST
            IF (ISTMG(I).NE.' '.OR.CCONST) THEN
                NBUFFG=NBUFFG+1
                IBUFFG(NBUFFG)=ISTMG(I)
            END IF
100     CONTINUE
 
        END
C ----------------------------------------------------------------------
C
C       C O M N T S   -   Process comments.
C                         Check for assertions and save non-assertion
C                         comments between statements.
C
 
        SUBROUTINE COMNTS(ISAVEA)
        INTEGER ISAVEA
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Character variables and arrays, except for dictionaries & VNAMEG
        INTEGER MAXCMG
        PARAMETER(MAXCMG=30)
        COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
 
        CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
        CHARACTER*6 NAMEG
        CHARACTER*72 ICOMG(MAXCMG)
 
        SAVE /CHARC/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  KEYWORD ID VARIABLES
      COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
     *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
     *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
     *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
     *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
     *         KDOG,        KELSEG,      KELSFG,      KENDFG,
     *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
     *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
     *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
     *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
     *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
     *         KREADG,      KREALG,      KRETNG,      KRFUNG,
     *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
     *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
     *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
     *         LLINEG,      LSTMTG
 
        INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
     +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
     +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
     +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
     +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
     +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
     +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
     +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
        INTEGER KUFUNG,KSUBRG
 
        SAVE /KEYSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
 
        INTEGER ICOL,ID(3),BODY(134),ASTEXT(3),BIND
        CHARACTER CARD*72
        EQUIVALENCE (CARD,ICARDG)
 
        INTRINSIC INDEX
 
        INTEGER ZSEDID,EQUAL
        EXTERNAL ZSEDID,EQUAL
 
        DATA ASTEXT/97,115,129/
 
        ISAVEA=1
        IF (ZSEDID(ISTTXT(ISTPTR(NTOKSS)),BIND,ID,BODY).NE.-2) GOTO 100
        IF (EQUAL(ID,ASTEXT).NE.-2) GOTO 100
C Is current statement being collected an assertion?
        IF (NSTMG.GT.0 .AND. ISTMG(1).EQ.'*') THEN
C Current statement being collected is assertion; return this comment as
C possible continuation.
            ISAVEA=0
        ELSE IF (ASSRTG) THEN
C This card may start an assertion
            ICOL=INDEX(CARD,'(')
            IF (ICOL.GT.0) THEN
C Left parenthesis found, comment starts assertion.
                ISAVEA=0
            ELSE
C No left parenthesis found; incorrect assertion format.
                CALL ERRORS(21)
                ISAVEA=1
            END IF
        END IF
 100    IF (ISAVEA.EQ.1) THEN
C Count comments (do not include assertions)
            CALL COUNTS(LCMNTG)
            IF (NCOMG.LT.MAXCMG) THEN
C Save this comment for output prior to statement.
                NCOMG=NCOMG+1
                ICOMG(NCOMG)=CARD
            END IF
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       C O U N T S   -   Update all program, routine and segment static
C                         counts for this item.
C
 
        SUBROUTINE COUNTS(ITEM)
        INTEGER ITEM
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  MAIN INTEGER STORAGE ARRAYS
C MAXLBG = Maximum number of DO statement labels per routine
        INTEGER MAXLBG
        PARAMETER(MAXLBG=100)
        COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
     *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
     *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
        INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
     +          KEXECG,LABG,KTOKG
        SAVE /WORKC/
 
C Increment Program, Routine and Segment counts
        IPCNTG(ITEM)=IPCNTG(ITEM)+1
        IRCNTG(ITEM)=IRCNTG(ITEM)+1
        ISCNTG(ITEM)=ISCNTG(ITEM)+1
 
        END
C ----------------------------------------------------------------------
C
C       D A R G S   -  Pick up dummy arguments from subroutine, function
C                      and entry argument lists
C
 
        SUBROUTINE DARGS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Character variables and arrays, except for dictionaries & VNAMEG
        INTEGER MAXCMG
        PARAMETER(MAXCMG=30)
        COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
 
        CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
        CHARACTER*6 NAMEG
        CHARACTER*72 ICOMG(MAXCMG)
 
        SAVE /CHARC/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Dictionary
C   MAXDDG = Maximum number of dimension names in dictionary
C   MAXRDG = Maximum number of routine names in dictionary
        INTEGER MAXDDG,MAXRDG
        PARAMETER(MAXDDG=150,MAXRDG=250)
        COMMON /ANDICT/ DDICTG,RDICTG
        CHARACTER*6 DDICTG(MAXDDG),RDICTG(MAXRDG)
        SAVE /ANDICT/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  KEYWORD ID VARIABLES
      COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
     *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
     *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
     *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
     *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
     *         KDOG,        KELSEG,      KELSFG,      KENDFG,
     *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
     *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
     *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
     *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
     *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
     *         KREADG,      KREALG,      KRETNG,      KRFUNG,
     *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
     *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
     *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
     *         LLINEG,      LSTMTG
 
        INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
     +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
     +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
     +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
     +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
     +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
     +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
     +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
        INTEGER KUFUNG,KSUBRG
 
        SAVE /KEYSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        INTEGER ITOK,JTOK,KTOK,LOCL
        CHARACTER*6 NAMEL
 
        CHARACTER*6 NAME
        INTEGER SFINDT
 
C Find start of argument list
*$AS$ (ITYPEG.EQ.KSUBRG .OR. ITYPEG.EQ.KNTRYG .OR. ITYPEG.EQ.KCFUNG .OR.
*$AS$  ITYPEG.EQ.KXFUNG .OR. ITYPEG.EQ.KDFUNG .OR. ITYPEG.EQ.KIFUNG .OR.
*$AS$  ITYPEG.EQ.KLFUNG .OR. ITYPEG.EQ.KRFUNG .OR. ITYPEG.EQ.KUFUNG)
        ITOK=NTOKG
 100    ITOK=ITOK+1
        IF (ITOK.LT.NTOKSS .AND. TOKTYP(ITOK).NE.TLPARN) GOTO 100
        IF (TOKTYP(ITOK).EQ.TLPARN) THEN
C Routine has an argument list
            CALL BALPRT(ITOK,KTOK)
C Is it all there?
            IF (KTOK.NE.0) THEN
C Look for comma
 200            JTOK=SFINDT(ITOK)
                IF (TOKTYP(JTOK).NE.TCOMMA) JTOK=KTOK
                NAMEL=' '
                IF (TOKTYP(JTOK+1).EQ.TNAME) NAMEL=NAME(JTOK+1)
                IF (NAMEL.NE.' ') THEN
C Save argument mnemonic as possible dummy routine name
                    CALL NSAVES(NAMEL,DDICTG,NDDICG,MAXDDG,LOCL)
C Write message if dictionary overflowed
                    IF (LOCL.EQ.0) CALL ERRORS(13)
                END IF
                IF (JTOK.LT.KTOK) THEN
                    ITOK=JTOK
                    GOTO 200
                END IF
            ELSE
C Parenthetical group not balanced
                CALL ERRORS(12)
            END IF
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       D M P C M S   -   Dump comment buffer to listing
C
 
        SUBROUTINE DMPCMS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Character variables and arrays, except for dictionaries & VNAMEG
        INTEGER MAXCMG
        PARAMETER(MAXCMG=30)
        COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
 
        CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
        CHARACTER*6 NAMEG
        CHARACTER*72 ICOMG(MAXCMG)
 
        SAVE /CHARC/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
 
        INTEGER L
 
        IF (NCOMG.GT.0) THEN
            DO 100 L=1,NCOMG
                CALL WRITOK(TCMMNT,ICOMG(L))
  100       CONTINUE
            NCOMG=0
        END IF
 
        END
C ----------------------------------------------------------------------
C
C       E R R O R S   -   Output an error message
C
 
        SUBROUTINE ERRORS(NERRA)
        INTEGER NERRA
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Character variables and arrays, except for dictionaries & VNAMEG
        INTEGER MAXCMG
        PARAMETER(MAXCMG=30)
        COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
 
        CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
        CHARACTER*6 NAMEG
        CHARACTER*72 ICOMG(MAXCMG)
 
        SAVE /CHARC/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Dictionary
C   MAXDDG = Maximum number of dimension names in dictionary
C   MAXRDG = Maximum number of routine names in dictionary
        INTEGER MAXDDG,MAXRDG
        PARAMETER(MAXDDG=150,MAXRDG=250)
        COMMON /ANDICT/ DDICTG,RDICTG
        CHARACTER*6 DDICTG(MAXDDG),RDICTG(MAXRDG)
        SAVE /ANDICT/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  KEYWORD ID VARIABLES
      COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
     *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
     *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
     *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
     *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
     *         KDOG,        KELSEG,      KELSFG,      KENDFG,
     *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
     *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
     *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
     *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
     *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
     *         KREADG,      KREALG,      KRETNG,      KRFUNG,
     *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
     *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
     *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
     *         LLINEG,      LSTMTG
 
        INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
     +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
     +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
     +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
     +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
     +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
     +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
     +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
        INTEGER KUFUNG,KSUBRG
 
        SAVE /KEYSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  MAIN INTEGER STORAGE ARRAYS
C MAXLBG = Maximum number of DO statement labels per routine
        INTEGER MAXLBG
        PARAMETER(MAXLBG=100)
        COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
     *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
     *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
        INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
     +          KEXECG,LABG,KTOKG
        SAVE /WORKC/
 
        EXTERNAL ERROR,REMARK,ZCHOUT,ZPTINT,ZMESS
 
        GOTO (100,110,120,130,150,160,170,180,190,200,210,220,230,240,
     +        250,260,270,280,290,300,310) NERRA
        CALL ERROR('Invalid argument to ERRORS')
 
 100    CALL ERROR('BAD ERRORS CALL 1')
 
 110    CALL ERROR('BAD ERRORS CALL 2')
 
 120    CALL ERROR('BAD ERRORS CALL 3')
 
 130    CALL ERROR('Input source file is -1')
 
 150    CONTINUE
        CALL REMARK('Error: End of assertion statement missing')
        CALL WRITOK(TCMMNT,'C*AN*ERROR* End of assertion missing')
        CALL COUNTS(LERRG)
        GOTO 666
 
 160    CONTINUE
        CALL REMARK('Error: Assertion too long')
        CALL WRITOK(TCMMNT,'C*AN*ERROR* Assertion too long')
        CALL COUNTS(LERRG)
        GOTO 666
 
 170    CONTINUE
        CALL REMARK('Error: Unrecognisable statement')
        CALL WRITOK(TCMMNT,'C*AN*ERROR* Unrecognisable statement')
        CALL COUNTS(LERRG)
        GOTO 666
 
 180    CALL ERROR('BAD ERROR CALL 8')
 
 190    CONTINUE
        CALL REMARK('Error: No STOP statements found')
        CALL REMARK('       Insert wrapup calls at termination points')
        GOTO 666
 
 200    CALL ERROR('BAD ERROR CALL 10')
 
 210    CALL ERROR('BAD ERROR CALL 11')
 
 220    CONTINUE
        CALL REMARK('Error: Unbalanced parentheses')
        CALL WRITOK(TCMMNT,'C*AN*ERROR* Unbalanced parentheses')
        CALL COUNTS(LERRG)
        GOTO 666
 
 230    IF (IERRG.EQ.0) THEN
            CALL ZCHOUT('Error: More than ',2)
            CALL ZPTINT(MAXDDG,1,2)
            CALL ZMESS(' in routine '//NAMEG,2)
            IERRG = 1
        END IF
        GOTO 666
 
 240    CALL ZCHOUT('Error: More than ',2)
        CALL ZPTINT(MAXRDG,1,2)
        CALL ZMESS(' routines an'//'d routine references',2)
        CALL ERROR('  ISTAN stopped at routine '//NAMEG)
 
 250    CALL ERROR('BAD ERRORS CALL 15')
 
 260    CALL ERROR('BAD ERRORS CALL 16')
 
 270    IF (JERRG.EQ.0) THEN
            CALL ZCHOUT('Error: DO-loops nested to more than ',2)
            CALL ZPTINT(MAXLBG,1,2)
            CALL ZMESS(' levels in routine '//NAMEG,2)
            CALL REMARK(
     +'       Loop-end statements will be segments at deeper levels')
            JERRG = 1
        END IF
        GOTO 666
 
 280    CALL ERROR('BAD ERRORS CALL 18')
 
 290    CALL ERROR('BAD ERRORS CALL 19')
 
 300    CALL REMARK('Error: Last statement in program isn''t END')
        GOTO 666
 
 310    CALL REMARK('Error: Invalid Assertion')
        CALL WRITOK(TCMMNT,'C*AN*ERROR* Invalid Assertion')
        CALL COUNTS(LERRG)
        GOTO 666
 
 666    RETURN
 
        END
C ----------------------------------------------------------------------
C
C       E X E C S   -   Output first routine segment when executable code
C                       reached
C
 
        SUBROUTINE EXECS
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C Character variables and arrays, except for dictionaries & VNAMEG
        INTEGER MAXCMG
        PARAMETER(MAXCMG=30)
        COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
 
        CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
        CHARACTER*6 NAMEG
        CHARACTER*72 ICOMG(MAXCMG)
 
        SAVE /CHARC/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  LOGICAL VARIABLES
      COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
     *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
     *         HISTG,       IEOFG,       IFDOG,       INSRTG,
     *         MAING,       SEGMTG,      STOPG,       TRACEG,
     *         TREEG
      LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
     *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
     *         IEOFG,       IFDOG,       INSRTG,      MAING,
     *         SEGMTG,      STOPG,       TRACEG,      TREEG
 
        SAVE /LOGIC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  CONTROL VARIABLES
      COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
     *         IUNITG,      JERRG,       KERRG,       LABFLG,
     *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
     *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
     *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
     *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
     *         NSTMG,       NTREEG,      NTYPEG
 
        INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
     +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
     +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
     +          NTREEG,NTYPEG
 
        SAVE /CNTRLC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  KEYWORD ID VARIABLES
      COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
     *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
     *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
     *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
     *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
     *         KDOG,        KELSEG,      KELSFG,      KENDFG,
     *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
     *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
     *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
     *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
     *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
     *         KREADG,      KREALG,      KRETNG,      KRFUNG,
     *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
     *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
     *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
     *         LLINEG,      LSTMTG
 
        INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
     +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
     +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
     +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
     +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
     +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
     +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
     +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
        INTEGER KUFUNG,KSUBRG
 
        SAVE /KEYSC/
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
C                  MAIN INTEGER STORAGE ARRAYS
C MAXLBG = Maximum number of DO statement labels per routine
        INTEGER MAXLBG
        PARAMETER(MAXLBG=100)
        COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
     *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
     *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
        INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
     +          KEXECG,LABG,KTOKG
        SAVE /WORKC/
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.4
C---------------------------------------------------------
C
C  TKLAST = LAST TOKEN NUMBER
C
      INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
     +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
     +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
     +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
     +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
     +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
     +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
     +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
     +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
     +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
     +        TFMTKD,TENDKD,TERRKD,TKLAST
      PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
     +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
     +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
     +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
     +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
     +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
     +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
     +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
     +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
     +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
     +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
     +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
     +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
     +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
     +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
     +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
     +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
 
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
     +                MAXICH
        INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
     +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
     +          MAXICH
 
        SAVE /TOKENS/
 
C
C TOKTYP = array of token types for current statement
C TOKLEN = parallel array of lengths of associated text strings
C TXTPTR = parallel array of pointers into ISTMG character array of text
C TOKEN = Current token number within statement being processed
C NTOKSS = Number of tokens in statement
C ISTTXT = IST text of token as read in before being converted by ZTOKTX
C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
C MAXICH = Last character used in ISTTXT array
C
C---------------------------------------------------------
C    TOOLPACK/1    Release: 2.3
C---------------------------------------------------------
        COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
        INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
 
        SAVE /IO/
 
 
        INTEGER DUMMY(2),LABEL(7),I
        CHARACTER*6 SEGNUM
 
        INTEGER LENGTH
        EXTERNAL ZTOKWR,SCOPY,LENGTH
 
        DATA DUMMY(1)/129/
 
        EXECG = .TRUE.
C Output first routine segment, unlabelled.
        IF (TOKTYP(1).EQ.TDCNST) THEN
            CALL SCOPY(ISTTXT,ISTPTR(1),LABEL,1)
            DO 100 I=1,LENGTH(LABEL)
                ISTTXT(ISTPTR(1)+I-1)=32
 100        CONTINUE
        END IF
        IF (LTYPEG.EQ.KENDG) THEN
            IF (TOKTYP(1).EQ.TDCNST) THEN
C This is first line of main routine and is labelled.
C Output extra annotation line for first segment.
                WRITE (SEGNUM,9000) NMSEG
                CALL WRITOK(TCMMNT,'*$AN$'//SEGNUM)
                CALL ZTOKWR(TPROGR,0,DUMMY,TKODES)
                CALL WRITOK(TNAME,'MAIN')
                CALL ZTOKWR(TZEOS,0,DUMMY,TKODES)
                CALL OUTSGS(ISBEG(NRTNG))
                SEGMTG=.FALSE.
            ELSE
C This is first line of main routine and not labelled - perform
C no special processing.
            END IF
        ELSE
C This is first executable line of routine but not first statement
C of routine. Output first segment with no other special processing.
            CALL OUTSGS(ISBEG(NRTNG))
            SEGMTG=.FALSE.
        END IF
 
        IF (TOKTYP(1).EQ.TDCNST) CALL SCOPY(LABEL,1,ISTTXT,ISTPTR(1))
 
9000    FORMAT(SS,I5)
        END
